home *** CD-ROM | disk | FTP | other *** search
/ Kit PC World De Ampliacion De Windows 95 / Kit PC World de ampliacion de Windows 95.iso / lotus / lotus022.dsk / SURFNET.MPR / SCRIPT / A007ApprGlobObj897.s (.txt) < prev    next >
Null Bytes Alternating  |  1995-11-13  |  16KB  |  259 lines
  1. '++LotusScript Development Environment:2:5:(Options):0:74
  2. Option Public
  3.  
  4.  
  5. '++LotusScript Development Environment:2:5:(Forward):0:1
  6. Declare Sub CallGNN
  7. Declare Function ReplaceStr (S As String, O As String, R As String) As String
  8. Declare Sub Initialize
  9. Declare Sub ParseNetscapeBookmark
  10.  
  11. '++LotusScript Development Environment:2:5:(Declarations):0:10
  12. Declare Public Function GetPrivateProfileString Lib"Kernel" (Byval lpName As String, Byval lpKey As Any, Byval lpDefault As String, Byval lpReturn As String, Byval nSize As Integer, Byval lpFile As String) As Integer
  13. Declare Public Function RegOpenKeyExA Lib "advapi32" Alias "RegOpenKeyExA" (Byval HKEY As Long,Byval lpszSubKey As String,Byval dwreserved As Integer,Byval samDesired As Long, keyresult As Long) As Long
  14. Declare Public Function RegQueryValueExA Lib "advapi32" Alias "RegQueryValueExA" (Byval HKEY As Long,Byval lpszValueName As String,Byval dwreserved As Integer, lpdwtype As Long, Byval lpData As String, readbytes As Long) As Long
  15. Declare Public Function RegCloseKey Lib "advapi32" Alias "RegCloseKey" (Byval HKEY As Long) As Long
  16. Declare Public Function GetPrivateProfileStringA Lib "kernel32" Alias "GetPrivateProfileStringA"(Byval AppName As String,Byval KName As Any, Byval Def As String, Byval RStr As String, Byval nSize As Integer, Byval FName As String) As Integer
  17.  
  18. Dim strURL As String
  19. Dim strPageTitle As String
  20.  
  21. Dim iMoreInfo As Integer   'Tracks 'more info' on the Found Set Report
  22.  
  23. '++LotusScript Development Environment:2:2:CallGNN:1:8
  24. Sub CallGNN
  25.     
  26.     
  27.     Dim happkey As Long
  28.     Dim HKEY_LOCAL_MACHINE As Long
  29.     Dim KEY_READ As Long
  30.     Dim HKEY_CURRENT_USER As Long
  31.     Dim HKEY_CLASSES_ROOT As Long
  32.     Dim ValueType As Long
  33.     Dim ReturnedKeyContents As String * 255
  34.     Dim readbytes As Long
  35.     Dim ReturnString As String * 255
  36.     MaxBytes%=Len(ReturnString$)
  37.     IniFileName$ = "Win.Ini"
  38.     ReturnedKeycontents$=String$(255,Chr$(32))
  39.     
  40.     HKEY_CLASSES_ROOT= &H80000000
  41.     HKEY_CURRENT_USER= &H80000001
  42.     HKEY_LOCAL_MACHINE= &H80000002
  43.     
  44.     KEY_QUERY_VALUE=1
  45.     KEY_ENUMERATE_SUBKEYS=8
  46.     KEY_NOTIFY=16
  47.     KEY_READ=KEY_QUERY_VALUE Or KEY_ENUMERATE_SUBKEYS Or KEY_NOTIFY
  48.     
  49.     KeyName$="http\shell\open\command"
  50.     URL$= "http://"+currentview.body.url.text
  51.     
  52.     GNNStat = GetPrivateProfileStringA("GNNWorks","AppPath","NA",ReturnString$,MaxBytes%,IniFileName$)
  53.     AppPath$=Left$(ReturnString$,GNNStat)
  54.     
  55.     If AppPath$="NA" Then ' did not find 16 bit GNN works
  56.         ValueName$=""
  57.         lstat=RegOpenKeyExA(HKEY_CLASSES_ROOT,KeyName$,0,KEY_READ,happkey)
  58.         ReadBytes=255
  59.         lstat=RegQueryValueExA(happkey,ValueName$,0,valueType, ReturnedKeyContents$,ReadBytes)
  60.         regclosekey(happkey)
  61.         If Trim$(ReturnedKeyContents$)="" Then
  62.             Messagebox("Approach can't determine if a WWW browser is installed, script aborted.")
  63.             Exit Sub
  64.         End If
  65.         BrowserPath$=Left$(ReturnedKeyContents$,ReadBytes-1)
  66.         
  67.         ' delete all command line params:
  68.         ExePos=Instr(BrowserPath$,".exe")
  69.         If ExePos<>0 Then
  70.             BrowserPath$=Left$(BrowserPath$,ExePos+4)
  71.         End If
  72.         
  73.         ' return path without leading quote, if there is one:
  74.         QuotePos=Instr(BrowserPath$,Chr$(34))
  75.         If QuotePos<>0 Then
  76.             BrowserPath$=Mid$(BrowserPath$,QuotePos+1)
  77.         End If
  78.     Else
  79.         ' found GNN Works
  80.         BrowserPath$ = Left(AppPath$,GNNStat) & "\IW.EXE"
  81.     End If
  82.     
  83.     LaunchPath$=BrowserPath$+" "+URL$
  84.     Err=0
  85.     On Error Resume Next
  86.     stat = Shell(LaunchPath$, 1)
  87.     On Error Goto 0
  88.     If Err<>0 Then
  89.         Messagebox "Error launching web browser, please check installation and try again.", MB_OK, "Error"
  90.     End If 
  91. End Sub
  92. '++LotusScript Development Environment:2:1:ReplaceStr:1:8
  93. Function ReplaceStr (S As String, O As String, R As String) As String
  94. ' S is the input string, O is the old string, R is the replacement string
  95.     If (S = "") Then
  96.         ReplaceStr = ""
  97.     Else
  98.         n = Instr(S,O)
  99.         While (n > 0)
  100.             Mid(S,n) = R
  101.             n = Instr(S,O)    
  102.         Wend
  103.         ReplaceStr = S
  104.     End If
  105. End Function
  106. '++LotusScript Development Environment:2:2:Initialize:1:10
  107. Sub Initialize
  108.     iMoreInfo = False
  109. End Sub
  110. '++LotusScript Development Environment:2:2:ParseNetscapeBookmark:1:8
  111. Sub ParseNetscapeBookmark
  112.     'Declarations
  113.     Dim strNetPath As String
  114.     Dim strBookmarkFile As String
  115.     Dim strBookmarks As String
  116.     Dim strType As String    
  117.     Dim strCrntHdr As String
  118.     Dim strSurfnet As String
  119.     Dim strTableName As String
  120.     Dim strCrntURL As String
  121.     Dim strCrntBkmrk As String
  122.     Dim strMsg As String   'Messag for message box.
  123.     
  124.     Dim iFileId As Integer
  125.     Dim rval As Integer   'Return value.
  126.        'Flag (0=quit, 1=quit, 2=go)
  127.     Dim iOK As Integer
  128.     
  129.     Dim lFileLen As Long
  130.     
  131.     Dim Con As New Connection
  132.     Dim Qry As New Query
  133.     Dim RS As New ResultSet
  134.     
  135.     'Array of bookmarks (Title, URL, Category)
  136.     Dim aryBookmarks(10, 10, 10) As String
  137.     
  138.     'Initializations
  139.     iOK = 0
  140.     strMsg = "Incorrect directory or file doesn't exist, try again?"
  141.     On Error Resume Next   'If error occurs, continue.
  142.     
  143.     Do Until (iOK <> 0)
  144.         strNetPath = Inputbox("Enter the name of the Netscape directory.", "Netscape Directory", "C:\NETSCAPE", 150, 150)
  145.         strBookmarkFile = strNetPath & "\BOOKMARK.HTM"
  146.         strTemp = Dir(strBookmarkFile)  'List the file.
  147.         If (strTemp = "") Then   'If the file doesn't exist...
  148.             rval = 1   'Reset
  149.             rval = Messagebox(strMsg , 1,  "Warning")
  150.             If (rval = 1) Then
  151.                 iOK = 0
  152.             Else
  153.                 iOK = 1
  154.             End If
  155.         Else
  156.             iOK = 2
  157.         End If
  158.     Loop
  159.     
  160.     If (iOK = 2) Then
  161.         lFileLen = Filelen(strBookmarkFile)
  162.         iFileId = 1
  163.         'Open the file.
  164.         Open strBookmarkFile For Input Access Read As iFileId Len = lFileLen
  165.         
  166.         strType = "N"
  167.         strTableName = CurrentDocument.Tables(0).FileName
  168.         strSurfnet = CurrentDocument.Path & strTableName
  169.         
  170.         'Use the data object to enter records.
  171.         If (Con.ConnectTo("dBASE IV")) Then
  172.             Set Qry.Connection = Con
  173.             Qry.Tablename = strSurfnet
  174.             Set RS.Query = Qry
  175.             If (RS.Execute = False) Then
  176.                 Messagebox "Couldn't access file for import."
  177.             End If
  178.         Else
  179.             Messagebox "Couldn't access file for import."
  180.         End If
  181.         
  182.         'Put the contents of the file in a variable.
  183.         strBookmarks = Input$(lFileLen, iFileId)
  184.         For i = 1 To lFileLen
  185.             'Reset the header if the bookmark has none.
  186.             If (Mid$(strBookmarks, i, 8) = "</DL><p>") Then
  187.                 strCrntHdr = ""
  188.             End If
  189.             
  190.             'Find the header.
  191.             If (Mid$(strBookmarks, i, 3) = "<H3") Then
  192.                 'We've found a header.
  193.                 strCrntHdr = ""
  194.                 'Now let's find the header name
  195.                 Do Until (Mid$(strBookmarks, i, 1) = ">")
  196.                     i = i + 1
  197.                 Loop
  198.                 i = i+ 1   'Get next character.
  199.                 'Get the header and put in a variable.
  200.                 strCrntHdr = ""   'Reset variable.
  201.                 Do Until (Mid$(strBookmarks, i, 1) = "<")
  202.                     strCrntHdr = strCrntHdr & Mid$(strBookmarks, i, 1)
  203.                     i = i+ 1
  204.                 Loop
  205.                 
  206.             'Find the bookmark
  207.             Elseif (Mid$(strBookmarks, i, 2) = "<A") Then
  208.             'We've found a bookmark
  209.                 strType = "B"
  210.             'Now let's find the URL
  211.                 Do Until (Mid$(strBookmarks, i, 1) = """")
  212.                     i = i + 1
  213.                 Loop
  214.                 i = i+ 1   'Get next character.
  215.                 
  216.             'Get the URL and put in a variable.
  217.                 Do Until (Mid$(strBookmarks, i, 1) = """")
  218.                     strCrntURL = strCrntURL & Mid$(strBookmarks, i, 1)
  219.                     i = i+ 1
  220.                 Loop
  221.                 
  222.                 'delete all http;// prefix
  223.                 Dim HTTPPos As Integer
  224.                 HTTPPos = Instr(strCrntURL, "http://")
  225.                 If HTTPPos <> 0 Then
  226.                     strCrntURL = Right$(strCrntURL, Len(strCrntURL) - 7)
  227.                 End If
  228.                 
  229.                 
  230.             'Now let's find the bookmark name.
  231.                 Do Until (Mid$(strBookmarks, i, 1) = ">")
  232.                     i = i + 1
  233.                 Loop
  234.                 i = i+ 1   'Get next character.
  235.             'Get the bookmark name  and put in a variable.
  236.                 Do Until (Mid$(strBookmarks, i, 1) = "<")
  237.                     strCrntBkmrk = strCrntBkmrk & Mid$(strBookmarks, i, 1)
  238.                     i = i+ 1
  239.                 Loop
  240.                 
  241.                 If (Mid$(strBookmarks, i, 4) = "</A>") Then
  242.                     'Now let's add the record to the file.
  243.                     RS.AddRow
  244.                     rval = RS.SetValue(2, strCrntBkmrk)
  245.                     rval = RS.SetValue(1, strCrntURL)
  246.                     rval = RS.SetValue(3, strCrntHdr)
  247.                     RS.UpdateRow
  248.                     strCrntURL = ""
  249.                     strCrntBkmrk = ""
  250.                 End If
  251.             End If
  252.         Next
  253.         Close(1)
  254.         RS.Close
  255.         Messagebox "Import complete.", MB_OK, "Import"
  256.     End If
  257.     
  258. EndImport:
  259. End Sub